Option Explicit
Sub F_Sample037()
   'Microsoft DAO 3.6 Object Library ]wޥζ
   'ոF_Data.mdb
    Dim myDb      As DAO.Database
    Dim mytbl     As DAO.TableDef
    Dim myIdx     As DAO.Index
    Dim myPIdx    As DAO.Index
    Dim myIfld    As DAO.Field
    Dim myFld     As DAO.Field
    Dim i         As Long
    Dim j         As Long
    Dim myFileName As String
    myFileName = "F_Data.mdb"                                 'wɮצW
    Set myDb = OpenDatabase(myFileName)
    With Worksheets
    On Error Resume Next
    Application.DisplayAlerts = False
    .Item("DAO_TABLEDEF").Delete
    Application.DisplayAlerts = True
    .Add.Name = "DAO_TABLEDEF"                      'sW檺W
    End With
   'wDC
    Cells(1, 1).Resize(, 5).Value = _
        Array("TBL_NAME", "FLD_NAME", "TYPE", "LEN", "ZERO")
    i = 2
    For Each mytbl In myDb.TableDefs
      ']ttΪ
        If mytbl.Attributes <> 0 Then GoTo Label1:
       'oDKEY
        For Each myIdx In mytbl.Indexes
            If myIdx.Primary = True Then
                Set myPIdx = myIdx
                Exit For
            End If
        Next
        Cells(i, 1).Value = mytbl.Name
        i = i + 1
        j = 1
        For Each myFld In mytbl.Fields
            With myFld
                Cells(i, 1).Resize(, 5).Value = _
         Array(j, .Name, GetConstStr_DAO(.Type), _
             .Size, .AllowZeroLength)
           For Each myIfld In myPIdx.Fields
                If myIfld.Name = myFld.Name Then Cells(i, 6).Value = "P"
                Next
            End With
            i = i + 1: j = j + 1
        Next myFld
        i = i + 1
Label1:
    Next mytbl
    myDb.Close
    Set myFld = Nothing                                    '
    Set mytbl = Nothing
    Set myDb = Nothing
End Sub
Function GetConstStr_DAO(myInt As Integer) As String
    Dim myStr As String
    Select Case myInt
        Case 1: myStr = "dbBoolean"
        Case 2: myStr = "dbByte"
        Case 3: myStr = "dbInteger"
        Case 4: myStr = "dbLong"
        Case 5: myStr = "dbCurrency"
        Case 6: myStr = "dbSingle"
        Case 7: myStr = "dbDouble"
        Case 8: myStr = "dbDate"
        Case 9: myStr = "dbBinary"
        Case 10: myStr = "dbText"
        Case 11: myStr = "dbLongBinary"
        Case 12: myStr = "dbMemo"
        Case 15: myStr = "dbGUID"
        Case 16: myStr = "dbBigInt"
        Case 17: myStr = "dbVarBinary"
        Case 18: myStr = "dbChar"
        Case 19: myStr = "dbNumeric"
        Case 20: myStr = "dbDecimal"
        Case 21: myStr = "dbFloat"
        Case 22: myStr = "dbTime"
        Case 23: myStr = "dbTimeStamp"
        Case Else: myStr = ""
    End Select
    GetConstStr_DAO = myStr
End Function
